perm filename NTS2.F4[P11,LCS] blob sn#583809 filedate 1981-05-02 generic text, type T, neo UTF8
C**** NTS2.F4, NTAIL *********
	SUBROUTINE NTS2
	COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
	EQUIVALENCE (J5,JQ(3)),(R4,RJQ(2)),(J7,JQ(5)),(J10,JQ(8)),
 	1(J6,JQ(4)),(R5,RJQ(3)) ,(R8,RJQ(6)),(R3,RJQ(1))
 	1,(RX4,JQ(19)),(JSTEM,JQ(20))
	R5=R5-J5
	IF(JSTEM.EQ.0)RETURN
C    RB    R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
	IF(L.LT.280)RB=CENTR+RZTM
C  ≥280 IS FOR 'X' NOTES.
128	J7=MOD(J7,10)
	RG=(J7-1)*14
	IF(RG.LT.0)RG=0
C 999 IS STANDARD (0) STEM LENGTH.
	IF(R8.NE.999.)GO TO 1751
	R8=0
	RH=0
	GO TO 2751
1751	IF(R8.LT.999.)GO TO 751
	R8=R8-1000.
	J10=-1 
C   WAS R10=-1 TO MAKE GRACE NOTE SLASH
C   1000+ PUTS SLASH ON NOTE STEM
751	RH=R8*RST7
2751	J5=MOD(J5,10)
C   ACCI NOW IN J5
	IF(JSTEM.NE.2)GO TO 1280
C   STEM EXTENSIONS ARE BY NOTE #S
	RJX=R3
C   FOR STEM DOWN (=2)
	RG=-RG-48.
	RH=-RH
	  RB=RB-RZTM*2
C  FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
	GO TO 129
C   NEXT IS FOR STEM UP.
1280	RJX=WID1
	IF(J6.LT.0)RJX=WID2
C IF(J6.LT.0)GET SPACE FOR HALF NOTE
2322	RJX=RJX*RMINI+R3
	 RG=RG+48.
129	RZ=CENTR+RH+RG*RMINI
	IF(RMINI.NE.RSTJ2)RJW=RJW*.6
	CALL LINX(RJX,RB,RJX,RZ)
C   RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
C    J5 HAS ACCID. # NOW
	IF(J7.LE.0)RETURN
C    JUMP IF NO TAILS
	CALL NTAIL
327	IF(R4.GE.RX4)RX4=R4+1
C  FOR TRILLS, ETC.
	IF(J10.GE.0)RETURN
	RJY=RZ-19.*RSTJ2
	RZ=RZ-RSTJ2*4.
	IF(RA.LT.0)GO TO 1327
C   NEXT IS FOR STEM DOWN SLASH
	RJY=RZ+23*RSTJ2
	RZ=RZ+RST7
1327	RJX=RJX-RST7
	CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
C FOR SLASH ON GRACE NOTE TAIL
	END

	SUBROUTINE NTAIL
	COMMON /STF/RSTFAC(0/7),RSTJ2
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
	EQUIVALENCE (R4,RJQ(2)),(J7,JQ(5)) ,(R8,RJQ(6)),(R3,RJQ(1))
 	1,(JSTEM,JQ(20))
	RJW=2.*RMINI/RSTJ2
	RA=1.
C   FOR VERT. SPACING OF MULTIPLE TAILS
	IF(JSTEM.NE.2)GO TO 1127
	R4=R4-3.7-R8
C  R4 IS USED IN SUBR. TAIL   - R8 IS STEM EXTENSION.
	RJW=-RJW
	GO TO 127
1127	R4=R4-2+R8
	RA=-RA
	R8=0
C    FOR SHIFT AT 246
127	CALL TAIL
	J7=J7-1
	IF(J7.EQ.0)RETURN
	R4=R4+RJW
	 GO TO 127 
C MOVES CENTR UP OR DOWN FOR NEXT TAIL
	END